home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / iconal2a / iconbook.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-13  |  23.5 KB  |  598 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form IconBook 
  5.    AutoRedraw      =   -1  'True
  6.    BackColor       =   &H00C0C0C0&
  7.    Caption         =   "IconAlbum Deluxe    1999 by Swertvaegher Stephan"
  8.    ClientHeight    =   8595
  9.    ClientLeft      =   975
  10.    ClientTop       =   1560
  11.    ClientWidth     =   11175
  12.    Icon            =   "IconBook.frx":0000
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    Moveable        =   0   'False
  17.    PaletteMode     =   1  'UseZOrder
  18.    ScaleHeight     =   573
  19.    ScaleMode       =   3  'Pixel
  20.    ScaleWidth      =   745
  21.    Begin VB.Frame Frame1 
  22.       BackColor       =   &H00C0C0C0&
  23.       Caption         =   "Selected Icon"
  24.       BeginProperty Font 
  25.          Name            =   "MS Sans Serif"
  26.          Size            =   9.75
  27.          Charset         =   0
  28.          Weight          =   700
  29.          Underline       =   -1  'True
  30.          Italic          =   0   'False
  31.          Strikethrough   =   0   'False
  32.       EndProperty
  33.       ForeColor       =   &H000000C0&
  34.       Height          =   2355
  35.       Left            =   45
  36.       TabIndex        =   6
  37.       Top             =   5310
  38.       Width           =   2445
  39.       Begin VB.PictureBox Pic3 
  40.          AutoSize        =   -1  'True
  41.          BackColor       =   &H00C0C0C0&
  42.          BorderStyle     =   0  'None
  43.          Height          =   480
  44.          Left            =   315
  45.          ScaleHeight     =   32
  46.          ScaleMode       =   3  'Pixel
  47.          ScaleWidth      =   32
  48.          TabIndex        =   7
  49.          ToolTipText     =   "Normal size icon"
  50.          Top             =   765
  51.          Width           =   480
  52.       End
  53.       Begin VB.Shape Shape2 
  54.          BackColor       =   &H00E0E0E0&
  55.          BorderColor     =   &H00008000&
  56.          BorderWidth     =   3
  57.          Height          =   1050
  58.          Left            =   1215
  59.          Shape           =   5  'Rounded Square
  60.          Top             =   675
  61.          Width           =   1050
  62.       End
  63.       Begin VB.Label Label4 
  64.          Alignment       =   2  'Center
  65.          BackColor       =   &H00C0C0C0&
  66.          ForeColor       =   &H00C00000&
  67.          Height          =   240
  68.          Left            =   135
  69.          TabIndex        =   9
  70.          Top             =   360
  71.          Width           =   2085
  72.       End
  73.       Begin VB.Image Image1 
  74.          Height          =   960
  75.          Left            =   1260
  76.          Stretch         =   -1  'True
  77.          ToolTipText     =   "Iconsize X 2"
  78.          Top             =   720
  79.          Width           =   960
  80.       End
  81.       Begin VB.Shape Shape1 
  82.          BackColor       =   &H00E0E0E0&
  83.          BorderColor     =   &H00008000&
  84.          BorderWidth     =   3
  85.          Height          =   645
  86.          Left            =   225
  87.          Shape           =   5  'Rounded Square
  88.          Top             =   675
  89.          Width           =   645
  90.       End
  91.       Begin VB.Label Label3 
  92.          Alignment       =   2  'Center
  93.          BackColor       =   &H00008000&
  94.          BorderStyle     =   1  'Fixed Single
  95.          ForeColor       =   &H0080FFFF&
  96.          Height          =   285
  97.          Left            =   45
  98.          TabIndex        =   8
  99.          Top             =   1935
  100.          Width           =   2355
  101.       End
  102.    End
  103.    Begin MSComctlLib.ImageList ImageList1 
  104.       Left            =   450
  105.       Top             =   3870
  106.       _ExtentX        =   1005
  107.       _ExtentY        =   1005
  108.       BackColor       =   -2147483643
  109.       ImageWidth      =   16
  110.       ImageHeight     =   16
  111.       MaskColor       =   12632256
  112.       _Version        =   393216
  113.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  114.          NumListImages   =   7
  115.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  116.             Picture         =   "IconBook.frx":0442
  117.             Key             =   ""
  118.          EndProperty
  119.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  120.             Picture         =   "IconBook.frx":059E
  121.             Key             =   ""
  122.          EndProperty
  123.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  124.             Picture         =   "IconBook.frx":06FA
  125.             Key             =   ""
  126.          EndProperty
  127.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  128.             Picture         =   "IconBook.frx":0856
  129.             Key             =   ""
  130.          EndProperty
  131.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  132.             Picture         =   "IconBook.frx":09BE
  133.             Key             =   ""
  134.          EndProperty
  135.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  136.             Picture         =   "IconBook.frx":0B1A
  137.             Key             =   ""
  138.          EndProperty
  139.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  140.             Picture         =   "IconBook.frx":0C82
  141.             Key             =   ""
  142.          EndProperty
  143.       EndProperty
  144.    End
  145.    Begin MSComctlLib.Toolbar Toolbar1 
  146.       Height          =   420
  147.       Left            =   90
  148.       TabIndex        =   4
  149.       Top             =   45
  150.       Width           =   2805
  151.       _ExtentX        =   4948
  152.       _ExtentY        =   741
  153.       ButtonWidth     =   609
  154.       ButtonHeight    =   582
  155.       Appearance      =   1
  156.       ImageList       =   "ImageList1"
  157.       _Version        =   393216
  158.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  159.          NumButtons      =   9
  160.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  161.             Style           =   3
  162.          EndProperty
  163.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  164.             Key             =   "keyNewdir"
  165.             Object.ToolTipText     =   "Create new directory"
  166.             ImageIndex      =   1
  167.          EndProperty
  168.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  169.             Key             =   "keyNameDir"
  170.             Object.ToolTipText     =   "Rename directory"
  171.             ImageIndex      =   4
  172.          EndProperty
  173.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  174.             Key             =   "keyRmDir"
  175.             Object.ToolTipText     =   "Remove directory"
  176.             ImageIndex      =   3
  177.          EndProperty
  178.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  179.             Key             =   "keyKillAll"
  180.             Object.ToolTipText     =   "Kill all Icons in map"
  181.             ImageIndex      =   6
  182.          EndProperty
  183.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  184.             Key             =   "keyCopyAll"
  185.             Object.ToolTipText     =   "Copy whole map"
  186.             ImageIndex      =   7
  187.          EndProperty
  188.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  189.             Key             =   "keySearch"
  190.             Object.ToolTipText     =   "Search for icons"
  191.             ImageIndex      =   2
  192.          EndProperty
  193.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  194.             Style           =   3
  195.          EndProperty
  196.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  197.             Key             =   "keyHelp"
  198.             Object.ToolTipText     =   "Helpfile"
  199.             ImageIndex      =   5
  200.          EndProperty
  201.       EndProperty
  202.       BorderStyle     =   1
  203.    End
  204.    Begin VB.PictureBox Pic2 
  205.       AutoRedraw      =   -1  'True
  206.       BackColor       =   &H00C0C0C0&
  207.       Height          =   7980
  208.       Left            =   2565
  209.       ScaleHeight     =   528
  210.       ScaleMode       =   3  'Pixel
  211.       ScaleWidth      =   567
  212.       TabIndex        =   2
  213.       Top             =   585
  214.       Width           =   8565
  215.       Begin VB.Image Im1 
  216.          Height          =   480
  217.          Index           =   0
  218.          Left            =   45
  219.          Top             =   45
  220.          Visible         =   0   'False
  221.          Width           =   480
  222.       End
  223.    End
  224.    Begin VB.DirListBox Dir1 
  225.       BackColor       =   &H00E0E0E0&
  226.       BeginProperty Font 
  227.          Name            =   "MS Sans Serif"
  228.          Size            =   8.25
  229.          Charset         =   0
  230.          Weight          =   700
  231.          Underline       =   0   'False
  232.          Italic          =   0   'False
  233.          Strikethrough   =   0   'False
  234.       EndProperty
  235.       ForeColor       =   &H00800000&
  236.       Height          =   3915
  237.       Left            =   45
  238.       TabIndex        =   1
  239.       Top             =   675
  240.       Width           =   2445
  241.    End
  242.    Begin VB.FileListBox File1 
  243.       Height          =   3405
  244.       Left            =   2520
  245.       Pattern         =   "*.ico"
  246.       TabIndex        =   0
  247.       Top             =   3690
  248.       Visible         =   0   'False
  249.       Width           =   1590
  250.    End
  251.    Begin MSComDlg.CommonDialog ComD1 
  252.       Left            =   9765
  253.       Top             =   -90
  254.       _ExtentX        =   847
  255.       _ExtentY        =   847
  256.       _Version        =   393216
  257.       CancelError     =   -1  'True
  258.       DefaultExt      =   ".ico"
  259.       Flags           =   2
  260.    End
  261.    Begin VB.Label Label2 
  262.       Alignment       =   2  'Center
  263.       BackColor       =   &H00C0C0C0&
  264.       BorderStyle     =   1  'Fixed Single
  265.       BeginProperty Font 
  266.          Name            =   "MS Sans Serif"
  267.          Size            =   9.75
  268.          Charset         =   0
  269.          Weight          =   700
  270.          Underline       =   0   'False
  271.          Italic          =   0   'False
  272.          Strikethrough   =   0   'False
  273.       EndProperty
  274.       ForeColor       =   &H00800000&
  275.       Height          =   510
  276.       Left            =   45
  277.       TabIndex        =   5
  278.       Top             =   4635
  279.       Width           =   2445
  280.    End
  281.    Begin VB.Line Line2 
  282.       BorderColor     =   &H00E0E0E0&
  283.       X1              =   0
  284.       X2              =   744
  285.       Y1              =   34
  286.       Y2              =   34
  287.    End
  288.    Begin VB.Line Line1 
  289.       BorderColor     =   &H00808080&
  290.       X1              =   0
  291.       X2              =   744
  292.       Y1              =   33
  293.       Y2              =   33
  294.    End
  295.    Begin VB.Label Label1 
  296.       BackColor       =   &H00C0C0C0&
  297.       BorderStyle     =   1  'Fixed Single
  298.       BeginProperty Font 
  299.          Name            =   "MS Sans Serif"
  300.          Size            =   9.75
  301.          Charset         =   0
  302.          Weight          =   700
  303.          Underline       =   0   'False
  304.          Italic          =   0   'False
  305.          Strikethrough   =   0   'False
  306.       EndProperty
  307.       ForeColor       =   &H00800000&
  308.       Height          =   330
  309.       Left            =   3105
  310.       TabIndex        =   3
  311.       Top             =   90
  312.       Width           =   8025
  313.    End
  314.    Begin VB.Menu mnuFile 
  315.       Caption         =   ""
  316.       Visible         =   0   'False
  317.       Begin VB.Menu mnuSaveAs 
  318.          Caption         =   "Save Icon As"
  319.       End
  320.       Begin VB.Menu mnubar0 
  321.          Caption         =   "-"
  322.       End
  323.       Begin VB.Menu mnuMove 
  324.          Caption         =   "Move Icon"
  325.       End
  326.       Begin VB.Menu mnubar1 
  327.          Caption         =   "-"
  328.       End
  329.       Begin VB.Menu mnuDelete 
  330.          Caption         =   "Delete Icon"
  331.       End
  332.       Begin VB.Menu mnubar2 
  333.          Caption         =   "-"
  334.       End
  335.       Begin VB.Menu mnuRenameIcon 
  336.          Caption         =   "Rename Icon"
  337.       End
  338.    End
  339. Attribute VB_Name = "IconBook"
  340. Attribute VB_GlobalNameSpace = False
  341. Attribute VB_Creatable = False
  342. Attribute VB_PredeclaredId = True
  343. Attribute VB_Exposed = False
  344. Private Sub Newdir() 'Make new dir
  345. On Error GoTo mkdir0
  346. Call InpBox(InpForm1, "Type the name of the new directory" & vbCr & "you want to create.", "", "IconAlbumDeluxe - New directory", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  347. If Inp1 = "" Then Exit Sub
  348. MkDir IBpath$ & "\" & Inp1
  349. Dir1.Refresh
  350. Pic2.SetFocus
  351. Exit Sub
  352. mkdir0:
  353. Call MBox(MFormDeluxe, "Cannot create the directory: " & Temp$ & vbCr & vbCr & "That directory already exists !", "Understood", "", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  354. End Sub
  355. Private Sub Search()
  356. SearchForm.Show 1
  357. Pic2.SetFocus
  358. End Sub
  359. Private Sub Dir1_Change()
  360. Dir1.Path = IBpath
  361. End Sub
  362. Private Sub Dir1_Click()
  363. Label3.Caption = ""
  364. Label4.Caption = "No icon selected"
  365. Pic3.Picture = LoadPicture("")
  366. Image1.Picture = LoadPicture("")
  367. File1.Path = Dir1.List(Dir1.ListIndex)
  368. If File1.ListCount <= 240 Then
  369. Idx% = File1.ListCount - 1
  370. Idx% = 239
  371. Call MBox(MFormDeluxe, "This map contains more than 240 icons..." & vbCr & "Only 240 icons will be shown !" & vbCr & vbCr & "You better create onother map of the same object" & vbCr & "to store some of the icons in it...", "Understood", "", "", 2, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  372. End If
  373. Label1.Caption = Dir1.List(Dir1.ListIndex)
  374. Label2.Caption = "Icons in map:" & vbCr & Idx% + 1
  375. DoEvents
  376. Screen.MousePointer = 11
  377. For xx% = 0 To Idx%
  378. If Right(File1.Path, 1) = "\" Then
  379. Im1(xx%).Picture = LoadPicture(File1.Path + File1.List(xx%))
  380. Im1(xx%).Picture = LoadPicture(File1.Path + "\" + File1.List(xx%))
  381. End If
  382. Im1(xx).Visible = True
  383. Next xx%
  384. Screen.MousePointer = 1
  385. If Idx < 239 Then
  386. For xx = Idx + 1 To 239
  387. Im1(xx%).Picture = LoadPicture("")
  388. Im1(xx).Visible = False
  389. Next xx
  390. End If
  391. End Sub
  392. Private Sub Form_Activate()
  393. 'Pic2.SetFocus
  394. End Sub
  395. Private Sub Form_Load()
  396. Dim HelpTxt$
  397. IBpath = App.Path
  398. IconBook.Move (Screen.Width - IconBook.Width) / 2, (Screen.Height - IconBook.Height) / 2
  399. Label4.Caption = "No icon selected"
  400. For xx = 1 To 239
  401. Load Im1(xx%)
  402. Next xx
  403. For xx = 0 To 15
  404. Im1(xx%).Left = Im1(0).Left + (xx% * 35)
  405. Im1(xx% + 16).Left = Im1(0).Left + (xx% * 35)
  406. Im1(xx% + 32).Left = Im1(0).Left + (xx% * 35)
  407. Im1(xx% + 48).Left = Im1(0).Left + (xx% * 35)
  408. Im1(xx% + 64).Left = Im1(0).Left + (xx% * 35)
  409. Im1(xx% + 80).Left = Im1(0).Left + (xx% * 35)
  410. Im1(xx% + 96).Left = Im1(0).Left + (xx% * 35)
  411. Im1(xx% + 112).Left = Im1(0).Left + (xx% * 35)
  412. Im1(xx% + 128).Left = Im1(0).Left + (xx% * 35)
  413. Im1(xx% + 144).Left = Im1(0).Left + (xx% * 35)
  414. Im1(xx% + 160).Left = Im1(0).Left + (xx% * 35)
  415. Im1(xx% + 176).Left = Im1(0).Left + (xx% * 35)
  416. Im1(xx% + 192).Left = Im1(0).Left + (xx% * 35)
  417. Im1(xx% + 208).Left = Im1(0).Left + (xx% * 35)
  418. Im1(xx% + 224).Left = Im1(0).Left + (xx% * 35)
  419. Im1(xx%).Top = Im1(0).Top
  420. Im1(xx% + 16).Top = Im1(0).Top + 35
  421. Im1(xx% + 32).Top = Im1(0).Top + 70
  422. Im1(xx% + 48).Top = Im1(0).Top + 105
  423. Im1(xx% + 64).Top = Im1(0).Top + 140
  424. Im1(xx% + 80).Top = Im1(0).Top + 175
  425. Im1(xx% + 96).Top = Im1(0).Top + 210
  426. Im1(xx% + 112).Top = Im1(0).Top + 245
  427. Im1(xx% + 128).Top = Im1(0).Top + 280
  428. Im1(xx% + 144).Top = Im1(0).Top + 315
  429. Im1(xx% + 160).Top = Im1(0).Top + 350
  430. Im1(xx% + 176).Top = Im1(0).Top + 385
  431. Im1(xx% + 192).Top = Im1(0).Top + 420
  432. Im1(xx% + 208).Top = Im1(0).Top + 455
  433. Im1(xx% + 224).Top = Im1(0).Top + 490
  434. Next xx%
  435. Dir1.Path = IBpath
  436. For xx = 0 To 14
  437. Pic2.Line (Im1(xx).Left + 33, 0)-(Im1(xx).Left + 33, Pic2.ScaleHeight), RGB(170, 180, 170)
  438. Next xx
  439. For xx = 1 To 15
  440. Pic2.Line (0, Im1(0).Top - 1 + (xx * 35))-(Pic2.ScaleWidth, Im1(0).Top - 1 + (xx * 35)), RGB(170, 180, 170)
  441. Next xx
  442. End Sub
  443. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  444. End Sub
  445. Private Sub Form_Resize()
  446. IconBook.Width = 11295
  447. IconBook.Height = 9000
  448. End Sub
  449. Private Sub Im1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  450. Im1(Index).ToolTipText = File1.List(Index)
  451. End Sub
  452. Private Sub mnuDelete_Click()
  453. Call MBox(MFormDeluxe, "Are you sure you want to delete the icon:" & vbCr & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx), "Delete !", "Oops !", "", 1, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  454. If Message(1) = True Then Exit Sub
  455. Kill Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%)
  456. File1.Refresh
  457. Dir1_Click
  458. End Sub
  459. Private Sub mnuMove_Click()
  460. Dim Oldpath$, Newpath$
  461. Oldpath$ = Dir1.List(Dir1.ListIndex)
  462. On Error GoTo mnuMove2
  463. Call InpBox(InpForm1, "You want to move the icon:" & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%) & vbCr & vbCr & "Type the name of the destination map:" & vbCr, DefInp, "IconAlbumDeluxe - Move Icon", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  464. If Inp1 = "" Then Exit Sub
  465. FileCopy Oldpath$ & "\" & File1.List(IconIdx%), IBpath & "\" & Inp1 & "\" & File1.List(IconIdx%)
  466. Kill Oldpath & "\" & File1.List(IconIdx%)
  467. File1.Refresh
  468. Dir1_Click
  469. Exit Sub
  470. mnuMove2:
  471. If Err = 76 Then
  472. Call MBox(MFormDeluxe, "The map " & Inp1 & " does not exist !" & vbCr & vbCr & "Do you want me to create it ?", "Create !", "Cancel all", "", 1, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  473. If Message(1) = True Then Exit Sub
  474. MkDir IBpath & "\" & Inp1
  475. Dir1.Refresh
  476. FileCopy Oldpath$ & "\" & File1.List(IconIdx%), IBpath & "\" & Inp1 & "\" & File1.List(IconIdx%)
  477. Kill Oldpath$ & "\" & File1.List(IconIdx%)
  478. File1.Refresh
  479. Dir1_Click
  480. Exit Sub
  481. End If
  482. Call MBox(MFormDeluxe, "There's a copy error !", "Understood", "", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  483. End Sub
  484. Private Sub mnuRenameIcon_Click()
  485. Dim Oldpath$, Newpath$
  486. Oldpath$ = Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx)
  487. On Error GoTo mnuMove2
  488. Call InpBox(InpForm1, "You want to rename the icon:" & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%) & vbCr & vbCr & "Type the new iconname (without the extention .ico)" & vbCr, "", "IconAlbumDeluxe - Rename Icon", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  489. If Inp1 = "" Then Exit Sub
  490. Newpath$ = Dir1.List(Dir1.ListIndex) & "\" & Inp1 & ".ico"
  491. Call MBox(MFormDeluxe, "You want to rename the icon: " & vbCr & Oldpath$ & vbCr & "as " & Newpath$ & vbCr & vbCr & "Continue ?", "Rename", "Abort", "", 1, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  492. If Message(1) = True Then Exit Sub
  493. Name Oldpath$ As Newpath$
  494. File1.Refresh
  495. Dir1_Click
  496. Label3.Caption = File1.List(IconIdx%)
  497. Exit Sub
  498. mnuMove2:
  499. Call MBox(MFormDeluxe, "Cannot rename the directory: " & vbCr & Oldpath$, "Understood", "", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  500. End Sub
  501. Private Sub mnuSaveAs_Click()
  502. On Error GoTo NoSave
  503. ComD1.FileName = File1.List(IconIdx%)
  504. ComD1.DialogTitle = "Save Icon"
  505. ComD1.ShowSave
  506. SavePicture Pic3.Picture, ComD1.FileName
  507. NoSave:
  508. End Sub
  509. Private Sub Im1_Click(Index As Integer)
  510. IconIdx% = Index
  511. Pic3.Picture = LoadPicture(File1.Path + "\" + File1.List(IconIdx))
  512. Image1.Picture = LoadPicture(File1.Path + "\" + File1.List(IconIdx))
  513. Label3.Caption = File1.List(IconIdx%)
  514. Label4.Caption = Pic3.ScaleWidth & " X " & Pic3.ScaleHeight & " Icon"
  515. PopupMenu mnuFile, , Pic2.Left + Im1(Index).Left + 32, Pic2.Top + Im1(Index).Top + 32
  516. End Sub
  517. Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  518. Select Case Button.Key
  519. Case "keyNewdir"
  520.     Newdir
  521. Case "keyRmDir"
  522.     RemoveDirectory
  523. Case "keyNameDir"
  524.     RenameDirectory
  525. Case "keyKillAll"
  526.     KillAll
  527. Case "keyCopyAll"
  528.     CopyAll
  529. Case "keySearch"
  530.     Search
  531. Case "keyHelp"
  532.     HelpForm.Show 1
  533. End Select
  534. End Sub
  535. Private Sub RemoveDirectory()
  536. On Error GoTo Remove2
  537. Call MBox(MFormDeluxe, "You want to remove the directory:" & vbCr & Dir1.List(Dir1.ListIndex) & vbCr & vbCr & "If the directory contains files," & vbCr & "it cannot be removed..." & vbCr & vbCr & "Do you wish to continue ?", "Continue", "Oops !", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  538. If Message(1) = True Then Exit Sub
  539. RmDir (Dir1.List(Dir1.ListIndex))
  540. Dir1.Refresh
  541. Exit Sub
  542. Remove2:
  543. Call MBox(MFormDeluxe, "Cannot remove the directory: " & vbCr & Dir1.List(Dir1.ListIndex) & vbCr & vbCr & "The directory probably contains files...", "Understood", "", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  544. End Sub
  545. Private Sub RenameDirectory()
  546. Dim Oldpath$, Newpath$
  547. Oldpath$ = Dir1.List(Dir1.ListIndex)
  548. On Error GoTo Rename2
  549. Call InpBox(InpForm1, "You want to rename the directory:" & vbCr & Oldpath$ & vbCr & vbCr & "Type the new name of the map:", DefInp, "IconAlbumDeluxe - Rename directory", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  550. If Inp1 = "" Then Exit Sub
  551. For xx = Len(Oldpath$) To 1 Step -1
  552.     If Mid(Oldpath$, xx, 1) = "\" Then
  553.     Newpath$ = Left(Oldpath$, xx)
  554.     Exit For
  555.     End If
  556. Next xx
  557. Newpath$ = Newpath$ & Inp1
  558. Call MBox(MFormDeluxe, "You want to rename the directory: " & vbCr & Oldpath$ & vbCr & "as " & Newpath$ & vbCr & vbCr & "Continue ?", "Rename", "Abort", "", 1, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  559. If Message(1) = True Then Exit Sub
  560. Name Oldpath$ As Newpath$
  561. Dir1.Refresh
  562. Exit Sub
  563. Rename2:
  564. Call MBox(MFormDeluxe, "Cannot rename the directory: " & vbCr & Oldpath$, "Understood", "", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  565. End Sub
  566. Private Sub KillAll()
  567. Dim Tel%
  568. Call MBox(MFormDeluxe, "Remove all icons from the directory: " & vbCr & Dir1.List(Dir1.ListIndex), "Kill All !", "Oops !", "", 1, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  569. If Message(1) = True Then Exit Sub
  570. Tel% = File1.ListCount
  571. Screen.MousePointer = 11
  572. For xx = 0 To File1.ListCount - 1
  573. Kill Dir1.List(Dir1.ListIndex) & "\" & File1.List(xx)
  574. Next xx
  575. Screen.MousePointer = 1
  576. File1.Refresh
  577. Dir1_Click
  578. Call MBox(MFormDeluxe, "Just killed " & Tel & " Icons...", "Got it !", "", "", 2, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  579. End Sub
  580. Private Sub CopyAll()
  581. Dim Oldpath$, Newpath$
  582. Oldpath$ = Dir1.List(Dir1.ListIndex)
  583. On Error GoTo mnuMove2
  584. Call InpBox(InpForm1, "You want to move the whole map:" & vbCr & Dir1.List(Dir1.ListIndex) & vbCr & vbCr & "Type the name of the destination map:" & vbCr, "", "IconAlbumDeluxe - Move Icon", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  585. If Inp1 = "" Then Exit Sub
  586. Screen.MousePointer = 11
  587. For xx = 0 To File1.ListCount - 1
  588. FileCopy Oldpath$ & "\" & File1.List(xx), IBpath & "\" & Inp1 & "\" & File1.List(xx)
  589. Kill Oldpath & "\" & File1.List(xx)
  590. Next xx
  591. Screen.MousePointer = 1
  592. File1.Refresh
  593. Dir1_Click
  594. Exit Sub
  595. mnuMove2:
  596. Call MBox(MFormDeluxe, "There's a copy error !", "Understood", "", "", 4, "IconAlbum Deluxe - System Message", 104, 194, 194, "Times New Roman", "MS Sans Serif", (IconBook.Width - MFormDeluxe.Width) / 2, 1000)
  597. End Sub
  598.